home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
opbonus.arc
/
TESTREPL.ARC
/
REPLMAIN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-03-20
|
5KB
|
172 lines
{$S-,R-,V-,I-,A-,O-,F-}
unit ReplMain;
{-Main unit for TESTREPL.PAS, to test OpReplay and OpSwap}
interface
uses
Dos,
OpString,
OpCrt,
OpSwap1;
{DON'T USE OPREPLAY ANYWHERE IN THIS USES STATEMENT}
var
{Pointers to OpReplay procedures and data}
CallStartMacro : procedure(P : Pointer);
CallStringToScrapMacro : procedure(S : String);
MacPtr : Pointer; {Address of macro to play back}
var
SaveInt16 : Pointer;
procedure InitializeTest;
{-Initialize the test TSR and go resident}
{=========================================================================}
implementation
const
HotKey = $0844; {<Alt><F10>}
ProgName : String[9] = 'TESTREPL';
SwapFile1 : String[15] = 'C:\TESTSWP1.$$$';
SwapFile2 : String[15] = 'C:\TESTSWP2.$$$';
UnloadTSR = 1;
UnloadSuccessful = 2;
UnloadFailed = 3;
procedure Abort(Msg : String; Code : Byte);
{-Write a message and halt}
begin
WriteLn(Msg);
Halt(Code);
end;
{$F+}
procedure MainPop;
{-The routine called when the hotkey is pressed}
begin
CallStringToScrapMacro('OpReplay will replay up to 127 characters');
CallStartMacro(MacPtr);
end;
{$F-}
{$F+}
procedure ExternalIfc;
{-Dispatches external requests}
var
TempSaveInt16 : Pointer;
CurInt16 : Pointer;
begin
with CSSwapData^.ThisIFC do
case LongInt(UserData) of
UnloadTSR :
begin
{Make Vectors reflect the original Int16 handler}
TempSaveInt16 := CSSwapData^.Vectors[$16];
SetVecOnReturn($16, SaveInt16);
if not CSSwapData^.SwapEnabled then begin {!!}
GetIntVec($16, CurInt16); {!!}
SetIntVec($16, SaveInt16); {!!}
end; {!!}
{Try to remove the TSR}
if DisableTSR then
LongInt(UserData) := UnloadSuccessful
else begin
if not CSSwapData^.SwapEnabled then {!!}
SetIntVec($16, CurInt16); {!!}
SetVecOnReturn($16, TempSaveInt16);
LongInt(UserData) := UnloadFailed;
end;
end;
else
Write('Unknown external interface request');
end;
end;
{$F-}
procedure DisableResidentCopy(IFC : IfcPtr);
{-Using the IfcPtr, disable the known resident copy of ourself}
var
Save : Boolean;
begin
with IFC^ do begin
RestoreAllVectors;
Save := CSDataPtr^.SwapMsgOn; {Save state of swap messages}
CSDataPtr^.SwapMsgOn := False; {Disable swap messages}
LongInt(UserData) := UnloadTSR; {UserData = UnLoadTSR command}
CmdEntryPtr; {Call the CmdEntryPtr}
{Check status of Unload attempt}
if LongInt(UserData) = UnloadSuccessful then begin
WriteLn(ProgName, ' removed from memory');
Halt;
end else begin
{Restore state of swap messages}
CSDataPtr^.SwapMsgOn := Save;
Abort('Unable to remove '+ProgName+' from memory', 1);
end;
end;
end;
function UnloadRequest : Boolean;
{-Return True if user requested unload at the DOS command line}
begin
UnloadRequest := (ParamCount > 0) and (StUpcase(ParamStr(1)) = '/U');
end;
procedure InstallCheck;
{-Are we installed? Unload if requested}
var
IFC : IfcPtr;
Regs : IntRegisters;
begin
{Check to see if we're already installed}
IFC := ModulePtrByName(ProgName);
if IFC <> nil then
{We are already installed}
if UnloadRequest then
{Try to unload}
DisableResidentCopy(IFC)
else
Abort(ProgName+' already installed', 1)
else if UnloadRequest then
Abort(ProgName+' not currently installed', 1);
end;
procedure InitializeTest;
{-Main initialization routine}
begin
{Check for previous installation, unload if requested}
InstallCheck;
{Install main hotkey}
if not DefinePop(HotKey, MainPop, Ptr(SSeg, SPtr)) then begin
WriteLn('Error defining popup procedure');
Halt;
end;
{Mark installation and define external interface routine}
InstallModule(ProgName, ExternalIfc);
{Don't show the swap message if swapping to EMS}
if WillSwapUseEms(ParagraphsToKeep) then
SetSwapMsgOn(False);
{Enable popups}
PopupsOn;
{Go resident}
WriteLn('Going resident, <Alt><F10> to stuff string');
StayResSwap(ParagraphsToKeep, 0, SwapFile1, SwapFile2, True);
WriteLn('Error going resident');
end;
end.